PC Shareware 1997 February/PC Shareware 1997-02.iso/programy/envlp122/envelop.3/Program/tools.eto

Text File | 1996-03-15 | 85KB | 2,793 lines

Type ScreenLayout
  Dim curItem As Integer
  Dim ScreenWidth As Integer
  Dim ScreenHeight As Integer

  ' METHODS for object: ScreenLayout
  Sub Clear
    ' Destroy all embedded layout items
    Dim wli As WindowLayoutItem
    For Each wli EmbeddedIn Me
      DestroyObject(wli)
    Next
  End Sub

  Sub DebugRestoreLayout()
    Dim wli As WindowLayoutItem

    ' Restore the saved visibility of all the windows.
    For Each wli EmbeddedIn Me
      If (wli.wnd) Then wli.wnd.Visible = wli.visible
    Next
  End Sub

  Sub DebugShowLayout()
    Dim wli As WindowLayoutItem

    ' Make all the windows visible, so we can see if they fit in layout.
    For Each wli EmbeddedIn Me
      If (wli.wnd) Then wli.wnd.Visible = True
    Next
  End Sub

  Sub EnsurePixels()
    ' The heuristic we'll use to decide whether an item needs to be scaled
    ' from twips to pixels is whether either of height or width is greater
    ' than 2000. This gets us away from the dangerous boundary cases where
    ' an item is saved in pixels, but is still near 1000 pixels in size, and
    ' also stays away from dependencies on the current screen resolution.
    ' It does introduce the possibility that a small form saved in twips
    ' may grow to be huge because we failed to scale it here. Tough.
    ' Furthermore, if I'm an EnvelopScreenLayout, then I was made at 15
    ' twips per pixel, period. Otherwise go ahead and use the tpp figure
    ' from the current display settings (found on Screen object).
    Dim WLI as WindowLayoutItem
    Dim factorX, factorY As Single
    If TypeOf Me Is EnvelopScreenLayout Then
      factorX = 15 : factorY = 15
    Else
      factorX = Screen.TwipsPerPixelX : factorY = Screen.TwipsPerPixelY
    End If

    For Each WLI EmbeddedIn Me
      If (WLI.height > 2000) || (WLI.width > 2000) Then
        WLI.left_ = WLI.left_ / factorX
        WLI.top = WLI.top / factorY
        WLI.width = WLI.width / factorX
        WLI.height = WLI.height / factorY
      End If
    Next WLI
  End Sub

  Function FitsScreen As Boolean
    FitsScreen = (ScreenWidth <= Screen.pixelWidth) && (ScreenHeight <= Screen.pixelHeight)
  End Function

  Sub Mark
    ' Mark all embedded items as not-visited
    Dim wli As WindowLayoutItem
    For Each wli EmbeddedIn Me
      wli.wnd = Nothing
    Next
  End Sub

  Sub Purge
    ' Destroy all embedded items that don't have a window recorded.
    Dim wli As WindowLayoutItem
    For Each wli EmbeddedIn Me
      If (wli.wnd = Nothing) Then DestroyObject(wli)
    Next
  End Sub

  Sub RestoreLayout()
    ' Restore windows' position/visibility as recorded by embedded items.
    Dim suspend as new SuspendDebugExceptionTrapping
    Dim wli As WindowLayoutItem

    EnsurePixels
    For Each wli EmbeddedIn Me
      If wli.wnd Then
        Try
          ' For non-Form objects, we know they need to be created first.
          If Not TypeOf wli.wnd Is Form Then wli.wnd.Visible = wli.visible
          If TypeOf wli.wnd Is Window Then
            ' Children of Window use twip coordinates
            With Screen
              wli.wnd.Move(wli.left_ * .TwipsPerPixelX, wli.top * .TwipsPerPixelY, wli.width * .TwipsPerPixelX, wli.height * .TwipsPerPixelY)
            End With
          Else
            ' Objects that don't inherit from Window use pixel coordinates
            wli.wnd.Move(wli.left_, wli.top, wli.width, wli.height)
          End If
          wli.wnd.Visible = wli.visible

          ' Notify the window itself, if it has a "ScreenLayoutRestore" method.
          If (MethodExists(wli.wnd, "ScreenLayoutRestore")) Then wli.wnd.ScreenLayoutRestore()

        catch NotFound(s as string)
        End Try
      End If
    Next
  End Sub

  Sub SaveExplicitWindow(nm As String)
    dim o as Object
    ' Given the string-name of an object, if it refers to an real object
    ' and it isn't already recorded, then save it.
    o = FindObject(nm)
    If o Then
      dim wli As WindowLayoutItem
      For Each wli EmbeddedIn Me
        If wli.wnd = o Then Exit Sub
      Next
    End If
    SaveWindow(o)
  End Sub

  Sub SaveExplicitWindows()
    ' This method is meant to be overridden to get certain windows saved explicitly.
  End Sub

  Sub SaveLayout()
    ' For each window record size/location and visibility information
    Dim suspend as new SuspendDebugExceptionTrapping
    curItem = 1

    Mark ' Mark all items as not-visited

    ' Save all created windows (have a Windows HWND)
    Screen.EnumWindows(Me, "SaveWindowFromHwnd")
    ' Save some windows explicitly
    SaveExplicitWindows()

    Purge ' Purge items which where not visited by the Save

    ' Record the screen width & height this layout was saved on
    ScreenWidth = Screen.pixelWidth
    ScreenHeight = Screen.pixelHeight
  End Sub

  Sub SaveWindow(wnd As Object)
    dim wndItem as WindowLayoutItem
    dim wndItemName As String
    dim factorX, factorY as Single

    ' If wnd is a child of Window, its coordinates will be in twips, it will
    ' need to be converted since all saved coordinates are in pixels.
    If TypeOf wnd is Window then
      factorX = 1.0 / Screen.TwipsPerPixelX
      factorY = 1.0 / Screen.TwipsPerPixelY
    Else
      factorX = 1
      factorY = 1
    End If

    wndItemName = "Item" & curItem

    ' Find or make a WindowLayoutItem object to hold the information
    wndItem = FindEmbed(Me, wndItemName)
    If Not wndItem Then wndItem = EmbedObject(Me, WindowLayoutItem, wndItemName)

    ' Fill in the information
    Try
      wndItem.wnd = wnd
      wndItem.left_ = wnd.Left * factorX
      wndItem.top = wnd.Top * factorY
      wndItem.width = wnd.Width * factorX
      wndItem.height = wnd.Height * factorY
      wndItem.visible = wnd.Visible
      curItem = curItem + 1
    catch NotFound(s as string)
      ' This window could not be saved successfully, disregard it.
    End Try
  End Sub

  Sub SaveWindowFromHwnd(ByVal hWnd As Long)
    dim o as Object
    o = FindObjectFromWindow(hWnd)
    If o Then SaveWindow(o)
  End Sub

  Function ShortName As String
    Dim name As String
    Dim pos, nextPos As Integer
    pos = 1
    name = Me
    Do
      nextPos = Instr(pos, name, ".")
      If nextPos > 0 Then pos = nextPos + 1
    Loop While nextPos > 0
    name = Mid(name, pos)
    ShortName = name
  End Function

End Type

Type ToolGadget From ButtonGadget
  Dim bitmap As New Bitmap
  Dim HintText As String

  ' METHODS for object: ToolGadget
  Sub DragAndDrop(o as XferData, x,y as single, state as OleDropState, effect as OleDropEffect)
    ' Forward all Drag&Drop stuff to ObjectBox
    If Parent Then SendEvent Parent.DragAndDrop(o, x, y, state, effect)
  End Sub

  Sub DragStart(o as XferData, x,y as single)
    o.ObjectRef = Me
    o.Drag(1)
  End Sub

End Type

Type InstallButton From Image
  Dim installObject As Window
  Dim BmpOpen As New OpenDialog
  Dim installBitmap As New Bitmap
  Dim SourceModule As String
  Dim InstalledSomething As Boolean
  Dim TargetPalette As ObjectBox
  Dim DefaultBitmap As New Bitmap
  Type InstallPair
    Dim bitmap As Bitmap
    Dim obj As Object
  End Type
  Property InstallName Get getInstallName As String
  Event Install

  ' METHODS for object: InstallButton
  Sub Click()
    dim CheckOf as New SuspendDebugExceptionTrapping

    BevelOuter = "Inset"
    InstalledSomething = False
    EnumObjectEmbeds(Me, Me, "EnumMethod")
    If Not InstalledSomething Then
      InfoBox.Message("Install not setup", "Installation configuration not correct.")
    End If
    BevelOuter = "Raised"
  End Sub

  Function Config(g as Object) As Boolean
    Dim ng as new ControlTools.Gadget

    ' If we were given an object, then take a guess about
    ' intended Object, apply it to a local ControlTools.Gadget,
    ' and call Detailed Edit to give a chance to Reconfigure
    If g Then
      If IsPrototype(g) Then
        ng.GadgetObject = g
      Else
        Dim od as new ObjDebug
        od.Obj = g
        ng.GadgetObject = od.ParentObject
      End If
    Else
      ng.GadgetObject = installObject
    End If

    ' Set the bitmap default
    ng.bitmap.SetPicture installBitmap.GetPicture

    ' Edit the gadget. Cancel will leave the GadgetObject empty.
    ' If not cancel, configure the install object and bitmap
    ng.DetailedEdit
    If ng.GadgetObject = "" Then
      Config = False
      Exit Function
    Else
      installObject = FindObject(ng.GadgetObject)
      installBitmap.SetPicture ng.bitmap.GetPicture

      Picture = installBitmap
      Refresh
      Config = True
    End If
  End Function

  Function DetailedEdit() As Long
    DetailedEdit = Config(Nothing)
  End Function

  Sub DragAndDrop(source As XferData, x As Single, y As Single, state As OleDropState, effect As OleDropEffect)
    dim g as object
    g = source.ObjectRef

    ' Default to "don't accept"
    effect = 0

    ' If DROP ...
    If state = "Drop" Then
      If Config(g) Then effect = 1
    Else  ' DRAG OVER
      ' Accept drop of gadgets and windows
      If TypeOf g Is Window Then effect = 1
    End If
  End Sub

  Sub EnumMethod(o as object)
    If TypeOf o Is InstallButton.InstallPair && o.obj && o.bitmap Then
      installObject = o.obj
      installBitmap.SetPicture(o.bitmap.GetPicture)
      If InstallSelObj Then InstalledSomething = True
    End If
  End Sub

  Function getInstallName As String
    If installObject Then
      getInstallName = IIf(HostObject(installObject), installObject.Name, installObject)
    Else
      getInstallName = ""
    End If
  End Function

  Sub Install()
    dim o as Object
    Dim f as New File
    ' This is the MOVEMODULECODE
    Dim m as ObjectModule
    m = ModuleManager.ModuleContaining(installObject)
    f.FileName = m.FileName
    f.FileName = App.Path & f.Name & f.Extension
    If f.Exists && Not InstalledSomething Then
      If YesNoBox.Message("Duplicate Module", f.FileName & " already exists, are you sure you want to overwrite?") = IDYES Then
        m.SaveAs(f.FileName, False)
        SourceModule = f.FileName
      End If
    Else
      m.SaveAs(f.FileName, False)
      SourceModule = f.FileName
    End If
    SendEvent TargetPalette.Install(Me)
  End Sub

  Sub InstallSample(o as Object, b as Bitmap)
    dim ng as ControlTools.Gadget

    ' Move the object into the module containing the "TargetPalette"
    AttachObjectToModule(o, TargetPalette)

    ' Insert a new gadget, at the bottom of the TargetPalette
    ng = EmbedObject(TargetPalette, ControlTools.Gadget, UniqueEmbedName(ControlTools.Palette, "SampleGadget"))
    ng.GadgetObject = o
    ng.bitmap.SetPicture(b.GetPicture)
    TargetPalette.ForceLayout(False)

  End Sub

  Function InstallSelObj As Boolean
    dim CheckOf as New SuspendDebugExceptionTrapping
    If YesNoBox.Message("Install", "Do you want to install '" & InstallName & "'?") = IDYES Then
      Dim obj as Object
      obj = installObject
      If TargetPalette = Nothing Then TargetPalette = ControlTools.Palette
      Try
        Dim okContinue as long
        Dim CacheMod as ObjectModule
        CacheMod = ModuleManager.CurrentModule
        okContinue = False
        SendEvent TargetPalette.PreInstall(Me, okContinue)
        If okContinue Then
          SendEvent Install()
          ModuleManager.CurrentModule = CacheMod
        End If
      Catch InstallFail(reason as string)
        MessageBox.Message("Install Failure", reason)
      End Try
      installObject = obj
      InstallSelObj = True
    End If
  End Function

  Sub Reset()
    installObject = Nothing
    installBitmap.LoadType = "FileBased"
    installBitmap.FileName = ""
    installBitmap.LoadType = "MemoryBased"
    Picture = DefaultBitmap
    Refresh
  End Sub

End Type

Type SuspendDebugExceptionTrapping
  Dim debugger As Object
  Dim TrapInterpretiveExceptions As Boolean
  Dim TrapSystemExceptions As Boolean

  ' METHODS for object: SuspendDebugExceptionTrapping
  Sub Construct(o As Object)
    ' This code is constructed so it will work whether or not
    ' the "Debugger" object is present in the system.
    debugger = FindObject("Debugger")
    If debugger Then
      TrapInterpretiveExceptions = debugger.TrapInterpretiveExceptions
      TrapSystemExceptions = debugger.TrapSystemExceptions
      debugger.TrapInterpretiveExceptions = False
      debugger.TrapSystemExceptions = False
    End If
  End Sub

  Sub Destruct()
    If debugger Then
      debugger.TrapInterpretiveExceptions = TrapInterpretiveExceptions
      debugger.TrapSystemExceptions = TrapSystemExceptions
    End If
  End Sub

End Type

Type HyperControl From Form

  ' METHODS for object: HyperControl
  Sub Resize()
    ' Place holder for resize code, to get initial size behavior.
  End Sub

End Type

Type ScreenLayoutConfigForm From Form
  Type BtnDone From Button

    ' METHODS for object: ScreenLayoutConfigForm.BtnDone
    Sub Click
      Parent.Hide
      Parent.ModalResult IDOK
    End Sub

  End Type
  Dim BtnSave As New Button
  Dim CbLayouts As New ComboBox
  Dim LayoutSet As ScreenLayoutSet
  Dim BtnRestore As New Button
  Dim BtnSetDefault As New Button
  Dim LblLegend As New Label
  Dim BtnDelete As New Button
  Dim BtnNewLayout As New Button

  ' METHODS for object: ScreenLayoutConfigForm
  Sub AddLayoutToList(o As Object)
    ' Add last name-component of embedded layout to list.
    If o && TypeOf o Is ScreenLayout Then
      Dim item, sn As String
      sn = o.ShortName
      item = IIf(o = LayoutSet.Default__Layout__, "*" & sn, sn)
      CbLayouts.AddItem item
    End If
  End Sub

  Sub BtnDelete_Click()
    Dim layout As ScreenLayout
    layout = SelectedLayout
    If layout Then
      Dim ynBox As New YesNoBox
      If ynBox.Message("Confirm delete layout", "Delete layout: " & SelectedLayoutName & "?") = IDYES Then
        DestroyObject(layout)
        SaveLayoutSetModule
        ResetList
      End If
    Else
      CbLayouts.Text = ""
    End If
  End Sub

  Sub BtnNewLayout_Click()
    If CbLayouts.Text <> "" && CbLayouts.ItemIndex(CbLayouts.Text) = -1 Then
      ' The user has typed and name and hasn't saved it.
      ' Pretend the Save button was clicked
      BtnSave_Click
      If IsIdentifierValid(CbLayouts.Text) Then BtnSetDefault_Click
    Else
      ' The text in the combobox is an existing layout, or doesn't
      ' exist, bring up a input dialog to name the layout
      Dim id as New InputDialog
      Dim HaveGoodName as Boolean
      Dim LastBadName as string
      HaveGoodName = False
      LastBadName = ""
      While Not HaveGoodName
        If id.Execute("Layout Name", "Enter a name for the new layout", LastBadName) = IDOK Then
          If Not IsIdentifierValid(id.Text) Then
            Dim err As New MessageBox
            err.SetIconExclamation
            err.Message("Invalid Identifier", """" & id.Text & """ is not a valid identifier")
            LastBadName = id.Text
          Else
            ' User typed a valid name
            HaveGoodName = True
          End If
        Else
          ' User hit cancel from the input dialog
          Exit Sub
        End If
      Wend
      ' User type a valid name and hit OK from the input dialog. Put
      ' the name into the ComboBox, then click the Save then SetDefault
      ' buttons
      CbLayouts.Text = id.Text
      BtnSave_Click
      BtnSetDefault_Click
    End If
  End Sub

  Sub BtnRestore_Click()
    RestoreSelectedLayout
    Show : BringToTop
  End Sub

  Sub BtnSave_Click()
    If LayoutSet Then
      Dim layoutName As String
      layoutName = SelectedLayoutName
      If layoutName <> "" Then
        Hide
        LayoutSet.SaveLayout(layoutName)
        SaveLayoutSetModule
        ResetList : CbLayouts.Text = layoutName
        Show : BringToTop
      End If
    End If
  End Sub

  Sub BtnSetDefault_Click()
    If LayoutSet Then
      If CbLayouts.Text = "" Then  ' Clear default layout
        LayoutSet.Default__Layout__ = Nothing
        SaveLayoutSetModule
        ResetList
      Else
        Dim layout As ScreenLayout
        layout = SelectedLayout ' Set default to selected layout
        If layout Then
          LayoutSet.Default__Layout__ = layout
          SaveLayoutSetModule
          ResetList
        End If
      End If
    End If
  End Sub

  Sub CbLayouts_DblClick()
    RestoreSelectedLayout
  End Sub

  Sub Execute(layoutSet As ScreenLayoutSet)
    If layoutSet Then
      ' Ensure me and my list are made before resetting the list.
      LayoutSet = layoutSet
      LoadForm
      ResetList
      Show
      BringToTop
    End If
  End Sub

  Sub ResetList
    CbLayouts.Clear
    If LayoutSet Then EnumObjectEmbeds(LayoutSet, Me, "AddLayoutToList")
  End Sub

  Sub Resize()
    Dim m, mm, hm, l, t, w, h, effWidth As Single
    hm = 45 : m = 90 : mm = 180
    effWidth = IIf(ScaleWidth < 3500, 3500, ScaleWidth)
    w = BtnDone.Width
    h = BtnDone.Height
    l = effWidth - w - m
    BtnDone.Move(l, m, w, h)
    t = h + mm
    BtnSave.Move(l, t, w, h)
    t = t + h + hm
    BtnRestore.Move(l, t, w, h)
    t = t + h + hm
    BtnSetDefault.Move(l, t, w, h)
    t = t + h + hm
    BtnDelete.Move(l, t, w, h)
    t = t + h + hm
    BtnNewLayout.Move(l, t, w, h)
    LblLegend.Top = ScaleHeight - LblLegend.Height - m
    CbLayouts.Move(m, m, l - mm, ScaleHeight - LblLegend.Height - mm)
  End Sub

  Sub RestoreSelectedLayout()
    Dim layout As ScreenLayout

    If CbLayouts.Text = "" Then
      ' If no layout is selected, just do what envelop normally does on startup
      EnvelopLayoutSet.AutoRestoreLayout
    Else
      layout = SelectedLayout
      If layout Then
        layout.RestoreLayout
      Else
        CbLayouts.Text = ""
      End If
    End If
  End Sub

  Sub SaveLayoutSetModule
    If LayoutSet Then
      ModuleManager.ModuleContaining(LayoutSet).Save
    End If
  End Sub

  Function SelectedLayout() As ScreenLayout
    SelectedLayout = Nothing
    If LayoutSet Then
      Dim layoutName As String
      layoutName = SelectedLayoutName
      If layoutName <> "" Then SelectedLayout = FindEmbed(LayoutSet, layoutName)
    End If
  End Function

  Function SelectedLayoutName As String
    SelectedLayoutName = ""
    If LayoutSet Then
      Dim layoutName As String
      Dim layout As ScreenLayout
      layoutName = CbLayouts.Text
      If layoutName = "" Then
        layoutName = LayoutSet.DefaultScreenLayoutName
        CbLayouts.Text = layoutName
      Else
        If Instr(layoutName, "*") = 1 Then layoutName = Mid(layoutName, 2)
        If Not IsIdentifierValid(layoutName) Then
          Dim err As New MessageBox
          err.SetIconExclamation
          err.Message("Invalid Identifier", """" & layoutName & """ is not a valid identifier")
          Exit Function
        End If
      End If
      SelectedLayoutName = layoutName
    End If
  End Function

End Type

Type ControlTools
  Type Gadget From ToolGadget
    Property HintText Get getHintText As String
    Property GadgetObject Get getGadgetObject Set setGadgetObject As String
    Dim gadgetObject_ As String
    Dim SourceModule As String

    ' METHODS for object: ControlTools.Gadget
    Sub Click()
      If VerifyExistence Then FormEditor.AddObject = FindObject(GadgetObject)
      ' Register with ControlTools.Palette so we pushed back up after add is done.
      If (TypeOf Parent Is ControlTools.Palette) Then Parent.addingGadget = Me
    End Sub

    Sub DblClick()
      ' Auto-embed a copy of our control
      dim newObject, addObject As Window
      dim name As String
      dim suspendTrap As New SuspendDebugExceptionTrapping
      ' Clear "adding" state of FormEditor, but remember object to add
      addObject = FindObject(GadgetObject)
      FormEditor.AddObject = Nothing

      name = UniqueEmbedName(FormEditor.CurForm, addObject)
      newObject = EmbedObject(FormEditor.CurForm, addObject, name)
      newObject.Left := 60 : newObject.Top := 60
      newObject.Width := 900 : newObject.Height := 450
      newObject.Caption := name
      FormEditor.SelectControl(newObject, False)
      FormEditor.Raise()
    End Sub

    Sub Destruct()
      dim o as Window

      ' If we represent an object in the controls module, offer to delete it.
      o = FindObject(GadgetObject)
      If o && (ModuleManager.ModuleContaining(Me) = ModuleManager.ModuleContaining(o)) Then
        Dim YNB as new YesNoBox
        YNB.message = "Would you like to Destroy '" & GadgetObject & "'?"
        YNB.Execute
        If YNB.result = IDYES Then DestroyObject(o)
      End If

    End Sub

    Function DetailedEdit() as long
      Dim outcome as long
      ' Display Wizard Modally if present
      Try
        CtrlToolGadgetWizard.ng = Me
        outcome = CtrlToolGadgetWizard.ShowModal
        If outcome = IDCANCEL Then
          DetailedEdit = False
        Else
          DetailedEdit = True
        End If
      Catch
      End Try
    End Function

    Sub DragStart(o as XferData, x,y as single)
      o.ObjectRef = Me
      o.Drag(1)
    End Sub

    Function Enable() As Integer
      ' Enabling of Control icons is based on a Form being edited.
      Enable = FormEditor.Editing && FormEditor.CurForm
    End Function

    Function getGadgetObject() As String
      getGadgetObject = gadgetObject_
    End Function

    Function getHintText() As String
      ' If the GadgetObject is not set or can be found, that is the
      ' hint, otherwise make hint be "<GadgetObject>*" to indicate
      ' that the object is not available.
      getHintText = IIf(Len(GadgetObject) = 0 || FindObject(GadgetObject), GadgetObject, GadgetObject & "*")
    End Function

    Sub setGadgetObject(s As String)
      ' Don't allow names of "dynamic"-objects
      If (Not Instr(s, "@")) Then gadgetObject_ = s
    End Sub

    Function VerifyExistence As Long

      ' Designer's note:
      ' Would it be worthwile to have VerifyExistence return an
      ' "error value" (say 1 if NoSourceModule, 2 if BadSourceModule...)
      ' Instead of the simple True/False?

      If FindObject(GadgetObject) Then
        ' The control exists
        VerifyExistence = True
      Else
        ' The control doesn't exist
        ' Check for SourceModule
        If SourceModule <> "" Then
          ' We know where the control originally came from
          ' Try to load it
          Dim o as Object
          o = ModuleManager.LoadModule(SourceModule, False)
          If o = Nothing Then
            ' Something failed in the LoadModule
            ' We don't have the control and can't get it
            VerifyExistence = False
          Else
            ' We loaded the module we expect the control to be in
            If FindObject(GadgetObject) Then
              ' We found the control
              VerifyExistence = True
            Else
              ' It's not where we expected
              ' We don't have the control and it's not where we thought
              VerifyExistence = False
              ' Unload the module that we loaded
              o.Unload
            End If
          End If
        Else
          ' We don't have the control and don't know where to get it
          VerifyExistence = False
        End If
      End If
    End Function

  End Type
  Type Palette From ObjectBox
    Dim addingGadget As ControlTools.Gadget
    Dim templateGadget As ButtonGadget
    Type GadArrow From ToolGadget

      ' METHODS for object: ControlTools.Palette.GadArrow
      Sub Click()
        FormEditor.AddObject = Nothing
        State = "Up"
      End Sub

      Sub DragStart(o as XferData, x,y as single)
        ' Override ToolGadget's
      End Sub

      Function Enable() As Integer
        Enable = FormEditor.Editing
        If (Parent.addingGadget && Not FormEditor.AddObject) Then
          Parent.addingGadget.State = "Up"
          Parent.addingGadget = Nothing
        End If
      End Function

    End Type
    Dim GadButton As New ControlTools.Gadget
    Dim GadOptionButton As New ControlTools.Gadget
    Dim GadCheckBox As New ControlTools.Gadget
    Dim GadLabel As New ControlTools.Gadget
    Dim GadTextBox As New ControlTools.Gadget
    Dim GadListBox As New ControlTools.Gadget
    Dim GadComboBox As New ControlTools.Gadget
    Dim GadHScrollBar As New ControlTools.Gadget
    Dim GadScrollBar As New ControlTools.Gadget
    Dim GadFrame As New ControlTools.Gadget
    Dim GadGauge As New ControlTools.Gadget
    Dim GadOle As New ControlTools.Gadget
    Dim GadMarkupLayer As New ControlTools.Gadget
    Dim GadPictureBox As New ControlTools.Gadget
    Dim GadImage As New ControlTools.Gadget
    Dim GadIndentedList As New ControlTools.Gadget
    Dim GadObjectHierarchy As New ControlTools.Gadget
    Dim GadObjectList As New ControlTools.Gadget
    Dim GadObjectCombo As New ControlTools.Gadget
    Dim GadFileListBox As New ControlTools.Gadget
    Dim GadFileComboBox As New ControlTools.Gadget
    Dim GadDataControl As New ControlTools.Gadget
    Dim GadGLControl As New ControlTools.Gadget
    Dim GadRichTextBox As New ControlTools.Gadget
    Dim GadListView As New ControlTools.Gadget
    Dim GadTabStrip As New ControlTools.Gadget
    Dim GadHyperControl As New ControlTools.Gadget
    Dim GadMenu As New ToolGadget
    Dim GadInstallButton As New ControlTools.Gadget
    Dim GadObjectBox As New ControlTools.Gadget
    Dim Empty As New ControlTools.Gadget

    Dim lastGad_ As ButtonGadget
    Property DropFeedbackGadget Get getLastGadget Set setLastGadget As Object

    Event Install(Package as Object)
    Event PreInstall(Package as Object, ok as long, LastMod as Long)

    ' METHODS for object: ControlTools.Palette
    Sub DragAndDrop(o as XferData, x,y as single, state as OleDropState, effect as OleDropEffect)
      Dim nm as String
      Dim dropObj as object
      Dim underPoint As ButtonGadget
      Dim suspend as new SuspendDebugExceptionTrapping

      ' Remember the object dropped and the gadget it was dropped on
      dropObj = o.ObjectRef
      underPoint = AtPoint(x, y)

      ' Default to "don't accept"
      effect = 0

      ' Don't allow a gadget to be dropped on itself. If no object dropped,
      ' forget it, also if no gadget under point forget it also.
      If Not dropObj || Not underPoint || dropObj = underPoint Then Exit Sub

      ' If DROP ...
      If state = "Drop" Then
        ' Disable feedback for drop location
        DropFeedbackGadget = Nothing

        ' If gadget from this palette is dropped on another gadget in this
        ' palette...
        If TypeOf dropObj Is ButtonGadget And dropObj.Parent = Me Then
          ' Swap the positions of control gadgets on same palette
          dropObj.Position = underPoint.Position

        ElseIf TypeOf dropObj Is Window Then
          ' If a "Window" is dropped on the palette, make a gadget at the
          ' drop location, set its "GadgetObject" to the dropped window
          ' and allow the user to edit it.
          Dim ng as ControlTools.Gadget
          Dim name as String
          Dim installObj as Object

          name = IIf(HostObject(dropObj), dropObj.Name, dropObj)

          Try
            ng = EmbedObject(Me, ControlTools.Gadget, "Gad" & name)
            ng.Position = underPoint.Position + 1
          catch MatchingFieldCollision
            InfoBox.Message("Install Failed", "A control by this name is already installed.")
            Exit Sub
          End Try

          ' do a forec layout to ensure that the new addition shows up
          ForceLayout(0)
          ng.GadgetObject = dropObj
          ng.DetailedEdit

          ' If the edit comes back successfully, move the object into the palette.
          ' Otherwise, remove the gadget.
          installObj = IIf(ng.GadgetObject <> "", FindObject(ng.GadgetObject), Nothing)
          If Not installObj Then
            DestroyObject(ng)
          Else
            Dim f as New File
            ' This is the MOVEMODULECODE
            Dim m as ObjectModule
            m = ModuleManager.ModuleContaining(FindObject(ng.GadgetObject))
            f.FileName = m.FileName
            f.FileName = App.Path & f.Name & f.Extension
            If f.Exists Then
              If YesNoBox.Message("Duplicate Module", f.FileName & " already exists, are you sure you want to overwrite?") = IDYES Then
                m.SaveAs(f.FileName, False)
                ng.SourceModule = f.FileName
              End If
            Else
              m.SaveAs(f.FileName, False)
              ng.SourceModule = f.FileName
            End If
          End If
        Else
          ' Reject the drop
          Exit Sub
        End If

        ' Accept the drop
        effect = 1

      ElseIf state = 1 Then  ' DRAG LEAVE
        ' Disable feedback for drop location
        DropFeedbackGadget = Nothing

      Else  ' DRAG OVER
        ' Accept drop of gadgets and windows
        If Not TypeOf underPoint Is ControlTools.Gadget Then Exit Sub
        If (TypeOf dropObj Is ButtonGadget && dropObj.Parent = Me) || TypeOf dropObj Is Window Then
          ' Provide feedback for drop location
          effect = 1
          DropFeedbackGadget = underPoint

        End If
      End If
    End Sub

    Sub GadMenu_Click()
      ' If there is a form under the sway of the form editor,
      ' then embed a menu bar within the form if it isn't there
      ' already
      If FormEditor.Editing && FormEditor.CurForm && FormEditor.CurForm.Visible Then
        Dim f as Form
        DIm m as Menu
        f = FormEditor.CurForm
        If f.MenuBar = Nothing Then
          f.MenuBar = EmbedObject(f, MenuBar, UniqueEmbedName(f, "menubar"))
          m = EmbedObject(f.MenuBar, PopupMenu, "Popup1")
          f.MenuBar.InsertPopup(m, "&File", -1)
        End If
        MenuEdit.ProcessMenu f.MenuBar
        MenuEdit.Show
        MenuEdit.BringToTop
      End If
    End Sub

    Function GadMenu_Enable() As Integer
      GadMenu_Enable = FormEditor.Editing && FormEditor.CurForm && FormEditor.CurForm.Visible
    End Function

    Function getLastGadget() as ButtonGadget
      getLastGadget = lastGad_
    End Function

    Sub Install(Package as Object)
      If TypeOf Package Is InstallButton Then
        dim o as Object
        dim b as Bitmap
        dim ng as ControlTools.Gadget

        o = Package.installObject
        b = Package.installBitmap

        ' Insert a new gadget, at the bottom of the TargetPalette
        ng = EmbedObject(Me, ControlTools.Gadget, "Gad" & Package.InstallName)
        ng.GadgetObject = o
        ng.bitmap.SetPicture(b.GetPicture)
        ng.SourceModule = Package.SourceModule
        ForceLayout(False)

      Else
        Throw InstallFail("Object sent to Install is not an InstallButton")
      End If
    End Sub

    Sub KeyDown(keyCode As Integer, ByVal shift As Integer)
      If (keyCode = VK_F1) Then Envelop.Help.ShowTopicHelp("Controls_Palette")
    End Sub

    Sub PreInstall(Package as Object, ok as long)
      If TypeOf Package Is InstallButton Then
        If FindEmbed(Me, "Gad" & Package.InstallName) Then
          ok = False
          Throw InstallFail("A ToolGadget already exists for " & Package.InstallName)
        Else
          ModuleManager.CurrentModule = ModuleManager.ModuleContaining(Me)
          ok = True
        End If
      Else
        Throw InstallFail("Object sent to PreInstall is not an InstallButton")
      End If
    End Sub

    Sub setLastGadget(g as ButtonGadget)
      If lastGad_ And g <> lastGad_ Then lastGad_.State = 0
      lastGad_ = g
      If lastGad_ Then lastGad_.State = 1
    End Sub

  End Type
End Type

Type ToolBitmap From Form
  Dim LblBitmap As New Label
  Dim TBBitmap As New TextBox
  Dim BtnFinish As New Button
  Type ImgGraphic From Image
    Dim bitmap As New Bitmap
  End Type
  Dim LblInstruction As New Label
  Dim Frame1 As New Frame
  Type BTNBrowse From Button

    ' METHODS for object: ToolBitmap.BTNBrowse
    Sub BtnBrowse_Click()
      Dim open as New OpenDialog

      ' Set the title of the open dialog just before we display it.
      open.Title = "Configure Tool Gadget"

      ' Set the filter to look for bitmaps
      open.Filter = "Bitmap files|*.bmp"

      ' If a filename was picked, then remember it
      ' Let the picture on this wizard preview it
      If open.Execute <> IDCANCEL Then
        TBBitmap.Text = open.FileName
      End If
    End Sub

  End Type
  Type SampleBox From ObjectBox
    Dim PreviewTool As New ToolGadget

    ' METHODS for object: ToolBitmap.SampleBox
    Sub Reposition
      dim l,t,w,h as long
      w = PreviewTool.bitmap.Width * 15
      If w > 4125 Then w = 4125
      If w < 150 Then w = 150
      h = PreviewTool.bitmap.Height * 15
      If h > 1575 Then h = 1575
      If h < 150 Then h = 150
      l = 2850 + ((4125 - w) / 2)
      t = 2175 + ((1575 - h) / 2)
      Move(l, t, w, h)
      PreviewTool.Refresh
      ForceLayout(True)
    End Sub

  End Type
  Dim BTNPreview As New Button
  Dim Caller As InstallButton

  ' METHODS for object: ToolBitmap
  Sub BTNBrowse_Click()
    Dim length As Integer
    Dim open as New OpenDialog

    ' Set the title of the open dialog just before we display it.
    open.Title = "Configure Tool Gadget"

    ' Set the filter to look for bitmaps
    open.Filter = "Bitmap files|*.bmp"

    ' If a filename was picked, then remember it
    ' Let the picture on this wizard preview it
    If open.Execute <> IDCANCEL Then
      TBBitmap.Text = open.FileName
      BTNPreview_Click
    End If
  End Sub

  Sub BtnFinish_Click()
    If Caller = Nothing Then
      Throw NoCaller
    Else
      Caller.installBitmap.LoadType = "FileBased"
      Caller.installBitmap.FileName = TBBitmap.Text
      Caller.installBitmap.LoadType = "MemoryBased"
      Caller.Refresh
      Caller = Nothing
      Hide
    End If
  End Sub

  Sub BTNPreview_Click()
    SampleBox.PreviewTool.bitmap.FileName = TBBitmap.Text
    SampleBox.Reposition
  End Sub

End Type

Type ToolPalette From ObjectBox
  Property DropFeedbackGadget Get getLastGadget Set setLastGadget As Object
  Dim lastGad_ As ButtonGadget
  Type AlignGadget From ToolGadget
    Dim alignType As Long

    ' METHODS for object: ToolPalette.AlignGadget
    Sub Click()
      FormEditor.Align(alignType)
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.NumSelected > 1
    End Function

  End Type
  Dim AlignR As New ToolPalette.AlignGadget
  Dim AlignT As New ToolPalette.AlignGadget
  Dim AlignB As New ToolPalette.AlignGadget
  Dim AlignLR As New ToolPalette.AlignGadget
  Dim AlignTB As New ToolPalette.AlignGadget
  Type SpaceH From ToolGadget

    ' METHODS for object: ToolPalette.SpaceH
    Sub Click()
      FormEditor.AlignHorizontally(5)
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.NumSelected > 1
    End Function

  End Type
  Type SpaceV From ToolGadget

    ' METHODS for object: ToolPalette.SpaceV
    Sub Click()
      FormEditor.AlignVertically(5)
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.NumSelected > 1
    End Function

  End Type
  Type ToggleGrid From ToolGadget

    ' METHODS for object: ToolPalette.ToggleGrid
    Sub Click()
      FormEditor.GridOn = Not FormEditor.GridOn
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.Editing && FormEditor.CurForm
      If (FormEditor.GridOn) Then State = "Down" Else State = "Up"
    End Function

  End Type
  Type FormEditorUndo From ToolGadget
    Property HintText Get getHintText As String

    ' METHODS for object: ToolPalette.FormEditorUndo
    Sub Click()
      FormEditor.Undo()
    End Sub

    Function Enable() As Integer
      Enable = ObjectEditorMgr.NextUndoItem <> "None"
    End Function

    Function getHintText() As String
      getHintText = "Undo: " & ObjectEditorMgr.NextUndoItem
    End Function

  End Type
  Type FormEditorRedo From ToolGadget
    Property HintText Get getHintText As String

    ' METHODS for object: ToolPalette.FormEditorRedo
    Sub Click()
      FormEditor.Redo()
    End Sub

    Function Enable() As Integer
      Enable = ObjectEditorMgr.NextRedoItem <> "None"
    End Function

    Function getHintText() As String
      getHintText = "Redo: " & ObjectEditorMgr.NextRedoItem
    End Function

  End Type
  Type TouchMode From ToolGadget

    ' METHODS for object: ToolPalette.TouchMode
    Sub Click()
      FormEditor.HitMode = "RgnTouches"
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.Editing && FormEditor.CurForm
      If (FormEditor.HitMode = "RgnTouches") Then
        State = "Down"
      Else
        State = "Up"
      End If
    End Function

  End Type
  Type ContainsMode From ToolGadget

    ' METHODS for object: ToolPalette.ContainsMode
    Sub Click()
      FormEditor.HitMode = "RgnContains"
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.Editing && FormEditor.CurForm
      If (FormEditor.HitMode = "RgnContains") Then State = "Down" Else State = "Up"
    End Function

  End Type
  Type CopyGadget From ToolGadget

    ' METHODS for object: ToolPalette.CopyGadget
    Sub Click()
      FormEditor.CopyControls()
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.NumSelected > 0
    End Function

  End Type
  Type Arrange From ToolGadget

    ' METHODS for object: ToolPalette.Arrange
    Sub Click()
      If (FormEditor.NumSelected > 0) Then
        FedArray.ShowModal()
      End If
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.NumSelected > 0
    End Function

  End Type
  Type Raise From ToolGadget

    ' METHODS for object: ToolPalette.Raise
    Sub Click()
      FormEditor.Raise()
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.NumSelected > 0
    End Function

  End Type
  Type Lower From ToolGadget

    ' METHODS for object: ToolPalette.Lower
    Sub Click()
      FormEditor.Lower()
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.NumSelected > 0
    End Function

  End Type
  Type ToggleTab From ToolGadget

    ' METHODS for object: ToolPalette.ToggleTab
    Sub Click()
      FormEditor.ShowOrder = Not FormEditor.ShowOrder
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.Editing && FormEditor.CurForm
    End Function

  End Type
  Type FontSet From ToolGadget

    ' METHODS for object: ToolPalette.FontSet
    Sub Click()
      ' Post common font panel to select font
      If (FontPicker.Execute() = 1) Then
        If FormEditor.NumSelected Then
          Dim i As Integer
          For i = 0 To FormEditor.NumSelected - 1
            FormEditor.GetSelected(i).Font = FontPicker.FontRef
          Next i
        Else
          FormEditor.CurForm.Font = FontPicker.FontRef
        End If
      End If
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.Editing && FormEditor.CurForm
    End Function

  End Type
  Type FColorSet From ToolGadget

    ' METHODS for object: ToolPalette.FColorSet
    Sub Click()
      ' Post common font panel to select font
      If (ColorDialog.Execute() = 1) Then
        If FormEditor.NumSelected Then
          Dim i As Integer
          For i = 0 To FormEditor.NumSelected - 1
            FormEditor.GetSelected(i).ForeColor = ColorDialog.Color
          Next i
        End If
      End If
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.NumSelected > 0
    End Function

  End Type
  Type BColorSet From ToolGadget

    ' METHODS for object: ToolPalette.BColorSet
    Sub Click()
      ' Post common font panel to select font
      If (ColorDialog.Execute() = 1) Then
        If FormEditor.NumSelected Then
          Dim i As Integer
          For i = 0 To FormEditor.NumSelected - 1
            FormEditor.GetSelected(i).BackColor = ColorDialog.Color
          Next i
        Else
          FormEditor.CurForm.BackColor = ColorDialog.Color
        End If
      End If
    End Sub

    Function Enable() As Integer
      Enable = FormEditor.Editing && FormEditor.CurForm
    End Function

  End Type
  Type ToggleObjectBoxEdit From ToolGadget

    ' METHODS for object: ToolPalette.ToggleObjectBoxEdit
    Sub Click()
      ObjectBoxEditor.ObjBoxForm.Visible = (State = "Down")
      If ObjectBoxEditor.ObjBoxForm.Visible Then ObjectBoxEditor.ObjBoxForm.SetCaption
    End Sub

  End Type

  ' METHODS for object: ToolPalette
  Sub DragAndDrop(o as XferData, x,y as single, state as OleDropState, effect as OleDropEffect)
    Dim nm as String
    dim dropObj as object
    dim underPoint As ButtonGadget

    dropObj = o.ObjectRef
    underPoint = AtPoint(x, y)

    ' Default to "don't accept"
    effect = 0

    ' Don't allow a gadget to be dropped on itself. If no object dropped,
    ' forget it.
    If Not dropObj || dropObj = underPoint Then Exit Sub

    ' If DROP ...
    If state = 3 Then
      ' Disable feedback for drop location
      DropFeedbackGadget = Nothing

      ' Dropped gadget...
      If TypeOf dropObj Is ButtonGadget && dropObj.Parent = Me Then
        ' Swap the positions of gadgets on same palette
        dropObj.Position = underPoint.Position

        ' Accept the drop
        effect = 1
      End If

    ElseIf state = 1 Then  ' DRAG LEAVE
      ' Disable feedback for drop location
      DropFeedbackGadget = Nothing

    Else  ' DRAG OVER
      ' Accept drop of ButtonGadgets from OUR PALETTE.
      If TypeOf dropObj Is ButtonGadget && dropObj.Parent = Me Then
        effect = 1

        ' Provide feedback for drop location
        DropFeedbackGadget = underPoint

      End If
    End If
  End Sub

  Function getLastGadget() as ButtonGadget
    getLastGadget = lastGad_
  End Function

  Sub KeyDown(keyCode As Integer, ByVal shift As Integer)
    If (keyCode = VK_F1) Then Envelop.Help.ShowTopicHelp("Tools_Palette")
  End Sub

  Sub setLastGadget(g as ButtonGadget)
    If lastGad_ And g <> lastGad_ Then lastGad_.State = 0
    lastGad_ = g
    If lastGad_ Then lastGad_.State = 1
  End Sub

End Type

Type FedArray From Form
  Dim Label1 As New Label
  Dim Label2 As New Label
  Dim Rows As New TextBox
  Dim Label3 As New Label
  Dim Columns As New TextBox
  Dim Label4 As New Label
  Dim WidthBox As New TextBox
  Dim Label5 As New Label
  Dim HeightBox As New TextBox
  Dim Label6 As New Label
  Dim ResizeBox As New CheckBox
  Dim Xoffset As New TextBox
  Dim Label7 As New Label
  Dim Yoffset As New TextBox
  Dim Label8 As New Label
  Dim OK As New Button
  Dim Cancel As New Button
  Dim runMode As Integer

  ' METHODS for object: FedArray
  Sub Cancel_Click()
    ModalResult(-1) : Hide
  End Sub

  Sub OK_Click()
    dim r,c,rs,cs,w,h,rz as integer
    r = Rows.Text
    c = Columns.Text
    cs = Xoffset.Text
    rs = Yoffset.Text
    w = WidthBox.Text
    h = HeightBox.Text
    rz = ResizeBox.Value
    ModalResult(0) : Hide

    If (runMode) Then
      FormEditor.ArrangeArray(r, c, rs, cs, w, h, rz)
    Else
      FormEditor.CreateArray(r, c, rs, cs, w, h, rz)
    End If
  End Sub

  Function ShowModal() As Long
    dim f strictly as Form
    dim w as Window

    ' Make sure Form is created, so configurations below stick.
    LoadForm()

    If (FormEditor.NumSelected = 1) Then
      Caption = "Duplicate control in array pattern"
      runMode = 0
    ElseIf (FormEditor.NumSelected > 1) Then
      Caption = "Arrange controls as an array"
      runMode = 1
    Else
      ShowModal = 0
      Exit Function
    End If

    w = FormEditor.GetSelected(0)
    Columns.Text = 1
    Rows.Text = FormEditor.NumSelected
    Xoffset.Text = 1
    Yoffset.Text = 1
    WidthBox.Text = w.Width / Screen.TwipsPerPixelX
    HeightBox.Text = w.Height / Screen.TwipsPerPixelY
    ResizeBox.Value = 0

    f = Me
    ShowModal = f.ShowModal()

  End Function

End Type

Type DataControl From HyperControl
  Dim DataMoveFirst As New Button
  Dim DataMovePrev As New Button
  Dim DataMoveNext As New Button
  Dim DataMoveLast As New Button
  Dim DataLabel As New TextBox
  Dim ButtonScale As Single
  Dim RecordSet As New RecordSet

  ' METHODS for object: DataControl
  Sub DataMoveFirst_Click()
    RecordSet.MoveFirst
  End Sub

  Sub DataMoveLast_Click()
    RecordSet.MoveLast
  End Sub

  Sub DataMoveNext_Click()
    RecordSet.MoveNext
    If RecordSet.EOF Then RecordSet.MovePrev
  End Sub

  Sub DataMovePrev_Click()
    RecordSet.MovePrev
    If RecordSet.BOF Then RecordSet.MoveNext
  End Sub

  Function DetailedEdit() As Long
    DataConConfigureWizard.Edit(Me)
    DetailedEdit = True
  End Function

  Sub Refresh()
    Dim f Strictly as Form
    f = Me
    f.Refresh
    RecordSet.Refresh
  End Sub

  Sub Resize()
    DataMoveFirst.Move(0, 0, ScaleWidth / ButtonScale, ScaleHeight)
    DataMovePrev.Move(DataMoveFirst.Width, 0, ScaleWidth / ButtonScale, ScaleHeight)
    DataLabel.Move(DataMovePrev.Left + DataMovePrev.Width, 0, ScaleWidth * (ButtonScale - 4) / ButtonScale, ScaleHeight)
    DataMoveNext.Move(DataLabel.Left + DataLabel.Width, 0, ScaleWidth / ButtonScale, ScaleHeight)
    DataMoveLast.Move(DataMoveNext.Left + DataMoveNext.Width, 0, ScaleWidth / ButtonScale, ScaleHeight)
  End Sub

End Type

Type WindowLayoutItem
  Dim wnd As Object
  Dim top As Single
  Dim width As Single
  Dim height As Single
  Dim visible As Boolean
  Dim left_ As Single
End Type

Type HScrollBar From ScrollBar
End Type

Type HelpFile From File
  Dim IsShowing As Integer

  ' METHODS for object: HelpFile
  Sub Contents()
    If Exists Then
      WinHelp(App.MainForm.hWnd, FileName, HELP_FORCEFILE, 0)
      WinHelp(App.MainForm.hWnd, FileName, HELP_CONTENTS, 0)
      IsShowing = True
    End If
  End Sub

  Sub GotoContext(context As Long)
    If Exists Then
      WinHelp(App.MainForm.hWnd, FileName, HELP_CONTEXT, context)
      IsShowing = True
    End If
  End Sub

  Sub HelpTopics()
    If Exists Then
      WinHelp(App.MainForm.hWnd, FileName, HELP_FINDER, 0)
      IsShowing = True
    End If
  End Sub

  Sub Index()
    If Exists Then
      WinHelp(App.MainForm.hWnd, FileName, HELP_INDEX, 0)
      IsShowing = True
    End If
  End Sub

  Sub Quit()
    If IsShowing Then
      WinHelp(App.MainForm.hWnd, FileName, HELP_QUIT, 0)
      IsShowing = False
    End If
  End Sub

End Type

Type FontPicker From Form
  Dim Cancel As New Button
  Dim OK As New Button
  Dim NothingButton As New Button
  Dim FontRef As Font
  Dim Workaround As Font
  Dim Sample As New TextBox
  Dim ObjList As New ObjectList
  Dim BtnNewFont As New Button
  Dim AllowNewFont As Boolean

  ' METHODS for object: FontPicker
  Sub BtnNewFont_Click()
    Dim ID As New InputDialog
    Dim FName As String
    Dim GoodName, Cancelled As Boolean
    Dim MB As New MessageBox
    GoodName = False
    Cancelled = False
    FName = ""
    While Not GoodName && Not Cancelled
      If ID.Execute("New Font", "Please Enter a Name for the New Top-Level Font", FName) = IDOK Then
        ' User Clicked OK. Verify that Font is legal...
        FName = ID.Text
        If Not ValidName(FName) Then
          MB.Message("Invalid Name", FName & " is not valid, please try again.")
        Else
          ' Name is a legal identifier, now check to see if it exists
          If FindObject(FName) Then
            MB.Message("Invalid Name", "An object named " & FName & " already exists. Please try again.")
          Else
            ' Name is a legal identifier, and isn't used. We're set!
            GoodName = True
          End If
        End If
      Else
        Cancelled = True
      End If
    Wend
    ' If the user cancelled, this block will be skipped
    If GoodName Then
      Dim FD As New FontDialog
      ' Need to use FindObject to get the top-level font, and not the
      ' font reference on the button
      FD.Font = CopyObject(FindObject("Font"), FName)
      If Not FD.Font Then
        ' FD.Font should ALWAYS be something at this point
      Else
        If FD.Execute = IDOK Then
          ' Configuration complete. Reset the ObjList, and select the
          ' user's new font.
          ObjList.Reset
          ObjList.SelObject = FD.Font
        Else
          ' They cancelled the FontDialog, ask if they want to keep the font
          Dim YNB As New YesNoBox
          If YNB.Message("Keep Old Font?", "Do you want to keep " & FName) = IDNO Then
            ' User doesn't want the font, and it's still in the FontDialog. Whack it!
            DestroyObject(FD.Font)
          End If
        End If
      End If
    End If
  End Sub

  Sub Cancel_Click()
    Hide() : ModalResult(0)
  End Sub

  Function Execute() As Integer
    Show()
    ObjList.SelObject = FontRef
    ObjList_Click()
    BtnNewFont.Visible = AllowNewFont

    Execute = ShowModal()
  End Function

  Sub Load()
    ' Overcome a serious name conflict
    ObjList.RootObject = Workaround
  End Sub

  Sub NothingButton_Click()
    FontRef = Nothing
    OK_Click()
  End Sub

  Sub ObjList_Click()
    FontRef = ObjList.SelObject
    Sample.Font = FontRef
  End Sub

  Sub ObjList_DblClick()
    ' Use font dialog to set it
    Dim FD As New FontDialog
    FD.Title = ObjList.SelObject
    FD.Font = ObjList.SelObject
    FD.Color = 0
    FD.Execute
  End Sub

  Sub OK_Click()
    Hide() : ModalResult(1)
  End Sub

  Function ValidName(ByVal namestr As String) As Boolean
    Dim i, char As Integer

    ' The Empty string is invalid
    If namestr = "" Then
      ValidName = False
      Exit Sub
    End If

    ' Make sure the first Char isn't a number or _
    char = Asc(Left$(namestr, 1))
    If (char >= 48 && char <= 57) || (char = 95) Then
      ValidName = False
      Exit Function
    End If

    ' Only legal Chars are Letters (Either Case), Numbers and _. Verify
    ' That EVERY char in the string is one of these cases.
    For i = 1 To Len(namestr)
      char = Asc(Mid$(namestr, i, 1))
      If (char < 65 || char > 90) && (char < 97 || char > 122) Then
        If (char < 48 || char > 57) && (char <> 95) Then
          ValidName = False
          Exit Function
        End If
      End If
    Next i
    ValidName = True
  End Function

End Type

Type ScreenLayoutSet
  Dim Default__Layout__ As ScreenLayout

  ' METHODS for object: ScreenLayoutSet
  Sub AutoRestoreLayout
    Dim layout As ScreenLayout

    ' First check our cached default layout
    layout = Default__Layout__
    If Not layout || Not layout.FitsScreen Then
      ' See if there's a layout named exactly "ScreenWxH"
      Dim layoutName As String
      layoutName = DefaultScreenLayoutName
      layout = FindEmbed(Me, layoutName)

      If Not layout Then
        ' OK, last shot. Pick the biggest layout that fits. Uses the
        ' Default__Layout__ as a scratch-pad reference.
        Dim tmpLayout As ScreenLayout
        tmpLayout = Default__Layout__
        Default__Layout__ = Nothing
        EnumObjectEmbeds(Me, Me, "FindBestLayout")
        layout = Default__Layout__
        Default__Layout__ = tmpLayout
      End If
    End If

    If layout Then layout.RestoreLayout
  End Sub

  Sub Clear
    ' Destroy all embedded layouts
    Dim sl As ScreenLayout
    For Each sl EmbeddedIn Me
      DestroyObject(o)
    Next
  End Sub

  Function DefaultScreenLayoutName As String
    DefaultScreenLayoutName = IIf(Default__Layout__, Default__Layout__.ShortName, "ScreenLayout" & Screen.pixelWidth & "x" & Screen.pixelHeight)
  End Function

  Sub FindBestLayout(o As Object)
    ' Compare layout to the previous best layout. If this layout fits
    ' on screen and covers more area, then it's better. See "AutoRestoreLayout" method
    If (TypeOf o Is ScreenLayout) && o.FitsScreen Then
      If Not Default__Layout__ Then
        Default__Layout__ = o
      Else
        Dim areaPrev, areaThis As Double
        areaPrev = Default__Layout__.ScreenWidth * Default__Layout__.ScreenHeight
        areaThis = o.ScreenWidth * o.ScreenHeight
        If areaThis > areaPrev Then Default__Layout__ = o
      End If
    End If
  End Sub

  Function SaveLayout(layoutName As String) As ScreenLayout
    Dim layout As ScreenLayout
    SaveLayout = Nothing

    ' Find or create the embedded layout in me.
    layout = FindEmbed(Me, layoutName)
    If Not layout Then
      layout = EmbedObject(Me, ScreenLayout, layoutName)
      If Not layout Then Exit Function
    End If

    ' Tell the layout to save the current screen.
    layout.SaveLayout
    SaveLayout = layout
  End Function

End Type

Type SuspendIgnoreExceptions
  Dim debugger As Object
  Dim IgnoreExceptionsModule As Integer

  ' METHODS for object: SuspendIgnoreExceptions
  Sub Construct(o As Object)
    ' This code is constructed so it will work whether or not
    ' the "Debugger" object is present in the system.
    debugger = FindObject("Debugger")
    If debugger Then
      IgnoreExceptionsModule = debugger.IgnoreExceptionsModule
      debugger.IgnoreExceptionsModule = -1
    End If
  End Sub

  Sub Destruct()
    If debugger Then debugger.IgnoreExceptionsModule = IgnoreExceptionsModule
  End Sub

End Type

Type TempTextFile From TextFile
  Dim prefix As String

  ' METHODS for object: TempTextFile
  Sub Destruct()
    ' Delete the file.
    Delete
  End Sub

  Function Init() As Boolean
    ' Generate a unique file name in the TEMP dir.
    InitializeFileName("")

    ' OK, we have a unique filename (which might exist).
    ' Create & open the file empty.
    Create(True)
    Init = Exists && IsOpen
  End Function

  Sub InitializeFileName(name As String)
    '
    ' Does nothing if FileName is already set.
    ' Otherwise, sets FileName up one of two ways:
    ' - No given name: generates a unique name of form %TEMP%\tmpXXXXX.tmp
    ' - Given name: sets name to %TEMP%\name
    '
    If FileName = "" Then
      Dim result As Long
      Dim tmpBuf As New DataBuffer
      Dim tempPath As String
      Dim pfx As String
      tmpBuf.Size = 260
      pfx = IIf(prefix = "", "tmp", prefix)

      ' Get TEMP dir.
      result = GetTempPath(tmpBuf.Size, tmpBuf.Data)
      If result = 0 || result > tmpBuf.Size Then
        Init = False
        Exit Function
      End If
      tempPath = tmpBuf.GetString(0)

      If name = "" Then
        ' Generate temp file name in TEMP dir.
        result = GetTempFileName(tempPath, pfx, 0, tmpBuf.Data)
        If result = 0 Then
          Init = False
          Exit Function
        End If
        FileName = tmpBuf.GetString(0)
      Else
        FileName = tempPath & name
      End If
    End If
  End Sub

  Function InitWithName(name As String) As Boolean
    ' Prepend the TEMP dir to name and set FileName to that.
    InitializeFileName(name)

    ' OK, we have a filename in the TEMP dir (which might exist).
    ' Create & open the file empty. Caller beware! We don't try
    ' to be nice here: if we can get it, it's gone.
    If Exists && ReadOnly Then ReadOnly = False
    Create(True)
    InitWithName = Exists && IsOpen
  End Function

End Type

Begin Code
' Reconstruction commands for object: ScreenLayout
'
  With ScreenLayout
    .curItem := 0
    .ScreenWidth := 0
    .ScreenHeight := 0
  End With  'ScreenLayout
' Reconstruction commands for object: ToolGadget
'
  With ToolGadget
    .HintText := ""
    With .bitmap
      .LoadType := "MemoryBased"
    End With  'ToolGadget.bitmap
  End With  'ToolGadget
' Reconstruction commands for object: InstallButton
'
  With InstallButton
    .Move(0, 0, 450, 450)
    .BevelOuter := "Raised"
    .Outlined := True
    .Picture := InstallButton.DefaultBitmap
    .installObject := Nothing
    .SourceModule := ""
    .InstalledSomething := False
    .TargetPalette := Nothing
    With .BmpOpen
      .Title := "Specify bitmap for Sample Icon"
      .NoChangeDir := False
    End With  'InstallButton.BmpOpen
    With .installBitmap
      .LoadType := "MemoryBased"
    End With  'InstallButton.installBitmap
    With .DefaultBitmap
      .LoadType := "MemoryBased"
    End With  'InstallButton.DefaultBitmap
    With .InstallPair
      .bitmap := Nothing
      .obj := Nothing
    End With  'InstallButton.InstallPair
  End With  'InstallButton
' Reconstruction commands for object: SuspendDebugExceptionTrapping
'
  With SuspendDebugExceptionTrapping
    .debugger := Nothing
    .TrapInterpretiveExceptions := False
    .TrapSystemExceptions := False
  End With  'SuspendDebugExceptionTrapping
' Reconstruction commands for object: HyperControl
'
  With HyperControl
    .Move(0, 0, 3600, 4320)
    .Outlined := True
    .MaxButton := False
    .MinButton := False
  End With  'HyperControl
' Reconstruction commands for object: ScreenLayoutConfigForm
'
  With ScreenLayoutConfigForm
    .Caption := "Configure Layouts"
    .Font := DefaultDialogFont
    .Move(4110, 1905, 3810, 2745)
    .CancelButton := ScreenLayoutConfigForm.BtnDone
    .MaxButton := False
    .LayoutSet := Nothing
    With .BtnDone
      .Caption := "Done"
      .ZOrder := 7
      .Move(2505, 90, 1095, 315)
    End With  'ScreenLayoutConfigForm.BtnDone
    With .BtnSave
      .Caption := "&Save"
      .ZOrder := 6
      .Move(2505, 495, 1095, 315)
    End With  'ScreenLayoutConfigForm.BtnSave
    With .CbLayouts
      .ZOrder := 5
      .Move(90, 90, 2325, 1905)
      .Style := "SimpleCombo"
    End With  'ScreenLayoutConfigForm.CbLayouts
    With .BtnRestore
      .Caption := "&Restore"
      .ZOrder := 4
      .Move(2505, 855, 1095, 315)
    End With  'ScreenLayoutConfigForm.BtnRestore
    With .BtnSetDefault
      .Caption := "Set de&fault"
      .ZOrder := 3
      .Move(2505, 1215, 1095, 315)
    End With  'ScreenLayoutConfigForm.BtnSetDefault
    With .LblLegend
      .Caption := "* = default screen layout"
      .ZOrder := 2
      .Move(240, 1995, 2130, 195)
    End With  'ScreenLayoutConfigForm.LblLegend
    With .BtnDelete
      .Caption := "&Delete"
      .ZOrder := 1
      .Move(2505, 1575, 1095, 315)
    End With  'ScreenLayoutConfigForm.BtnDelete
    With .BtnNewLayout
      .Caption := "&New"
      .ZOrder := 1
      .Move(2505, 1965, 1095, 315)
    End With  'ScreenLayoutConfigForm.BtnNewLayout
  End With  'ScreenLayoutConfigForm
' Reconstruction commands for object: ControlTools
'
  With ControlTools
    With .Gadget
      .ButtonType := "Exclusive"
      .GadgetObject := ""
      .gadgetObject_ := ""
      .SourceModule := ""
      With .bitmap
      End With  'ControlTools.Gadget.bitmap
    End With  'ControlTools.Gadget
    With .Palette
      .Caption := "Controls"
      .ZOrder := 1
      .Move(14370, 1125, 915, 6945)
      .addingGadget := Nothing
      .templateGadget := ControlTools.Gadget
      .lastGad_ := Nothing
      .DropFeedbackGadget := Nothing
      With .GadArrow
        .Position := 1
        .HintText := "Cancel Add Control"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 0
        End With  'ControlTools.Palette.GadArrow.bitmap
      End With  'ControlTools.Palette.GadArrow
      With .GadButton
        .Position := 2
        .GadgetObject := "Button"
        .gadgetObject_ := "Button"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 404
        End With  'ControlTools.Palette.GadButton.bitmap
      End With  'ControlTools.Palette.GadButton
      With .GadOptionButton
        .Position := 3
        .GadgetObject := "OptionButton"
        .gadgetObject_ := "OptionButton"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 808
        End With  'ControlTools.Palette.GadOptionButton.bitmap
      End With  'ControlTools.Palette.GadOptionButton
      With .GadCheckBox
        .Position := 4
        .GadgetObject := "CheckBox"
        .gadgetObject_ := "CheckBox"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 1212
        End With  'ControlTools.Palette.GadCheckBox.bitmap
      End With  'ControlTools.Palette.GadCheckBox
      With .GadLabel
        .Position := 5
        .GadgetObject := "Label"
        .gadgetObject_ := "Label"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 1616
        End With  'ControlTools.Palette.GadLabel.bitmap
      End With  'ControlTools.Palette.GadLabel
      With .GadTextBox
        .Position := 6
        .GadgetObject := "TextBox"
        .gadgetObject_ := "TextBox"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 2020
        End With  'ControlTools.Palette.GadTextBox.bitmap
      End With  'ControlTools.Palette.GadTextBox
      With .GadListBox
        .Position := 7
        .GadgetObject := "ListBox"
        .gadgetObject_ := "ListBox"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 2424
        End With  'ControlTools.Palette.GadListBox.bitmap
      End With  'ControlTools.Palette.GadListBox
      With .GadComboBox
        .Position := 8
        .GadgetObject := "ComboBox"
        .gadgetObject_ := "ComboBox"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 2828
        End With  'ControlTools.Palette.GadComboBox.bitmap
      End With  'ControlTools.Palette.GadComboBox
      With .GadHScrollBar
        .Position := 9
        .GadgetObject := "HScrollBar"
        .gadgetObject_ := "HScrollBar"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 3232
        End With  'ControlTools.Palette.GadHScrollBar.bitmap
      End With  'ControlTools.Palette.GadHScrollBar
      With .GadScrollBar
        .Position := 10
        .GadgetObject := "ScrollBar"
        .gadgetObject_ := "ScrollBar"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 3636
        End With  'ControlTools.Palette.GadScrollBar.bitmap
      End With  'ControlTools.Palette.GadScrollBar
      With .GadFrame
        .Position := 11
        .GadgetObject := "Frame"
        .gadgetObject_ := "Frame"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 4040
        End With  'ControlTools.Palette.GadFrame.bitmap
      End With  'ControlTools.Palette.GadFrame
      With .GadGauge
        .Position := 12
        .GadgetObject := "Gauge"
        .gadgetObject_ := "Gauge"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 4444
        End With  'ControlTools.Palette.GadGauge.bitmap
      End With  'ControlTools.Palette.GadGauge
      With .GadOle
        .Position := 13
        .GadgetObject := "Ole"
        .gadgetObject_ := "Ole"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 4848
        End With  'ControlTools.Palette.GadOle.bitmap
      End With  'ControlTools.Palette.GadOle
      With .GadMarkupLayer
        .Position := 14
        .GadgetObject := "MarkupLayer"
        .gadgetObject_ := "MarkupLayer"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 5252
        End With  'ControlTools.Palette.GadMarkupLayer.bitmap
      End With  'ControlTools.Palette.GadMarkupLayer
      With .GadPictureBox
        .Position := 15
        .GadgetObject := "PictureBox"
        .gadgetObject_ := "PictureBox"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 5656
        End With  'ControlTools.Palette.GadPictureBox.bitmap
      End With  'ControlTools.Palette.GadPictureBox
      With .GadImage
        .Position := 16
        .GadgetObject := "Image"
        .gadgetObject_ := "Image"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 6060
        End With  'ControlTools.Palette.GadImage.bitmap
      End With  'ControlTools.Palette.GadImage
      With .GadIndentedList
        .Position := 17
        .GadgetObject := "IndentedList"
        .gadgetObject_ := "IndentedList"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 6464
        End With  'ControlTools.Palette.GadIndentedList.bitmap
      End With  'ControlTools.Palette.GadIndentedList
      With .GadObjectHierarchy
        .Position := 18
        .GadgetObject := "ObjectHierarchy"
        .gadgetObject_ := "ObjectHierarchy"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 6868
        End With  'ControlTools.Palette.GadObjectHierarchy.bitmap
      End With  'ControlTools.Palette.GadObjectHierarchy
      With .GadObjectList
        .Position := 19
        .GadgetObject := "ObjectList"
        .gadgetObject_ := "ObjectList"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 7272
        End With  'ControlTools.Palette.GadObjectList.bitmap
      End With  'ControlTools.Palette.GadObjectList
      With .GadObjectCombo
        .Position := 20
        .GadgetObject := "ObjectCombo"
        .gadgetObject_ := "ObjectCombo"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 7676
        End With  'ControlTools.Palette.GadObjectCombo.bitmap
      End With  'ControlTools.Palette.GadObjectCombo
      With .GadFileListBox
        .Position := 21
        .GadgetObject := "FileListBox"
        .gadgetObject_ := "FileListBox"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 8080
        End With  'ControlTools.Palette.GadFileListBox.bitmap
      End With  'ControlTools.Palette.GadFileListBox
      With .GadFileComboBox
        .Position := 22
        .GadgetObject := "FileComboBox"
        .gadgetObject_ := "FileComboBox"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 8484
        End With  'ControlTools.Palette.GadFileComboBox.bitmap
      End With  'ControlTools.Palette.GadFileComboBox
      With .GadGLControl
        .Position := 23
        .GadgetObject := "GLControl"
        .gadgetObject_ := "GLControl"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 8888
        End With  'ControlTools.Palette.GadGLControl.bitmap
      End With  'ControlTools.Palette.GadGLControl
      With .GadDataControl
        .Position := 24
        .GadgetObject := "DataControl"
        .gadgetObject_ := "DataControl"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 9292
        End With  'ControlTools.Palette.GadDataControl.bitmap
      End With  'ControlTools.Palette.GadDataControl
      With .GadRichTextBox
        .Position := 25
        .GadgetObject := "RichTextBox"
        .gadgetObject_ := "RichTextBox"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 14704
        End With  'ControlTools.Palette.GadRichTextBox.bitmap
      End With  'ControlTools.Palette.GadRichTextBox
      With .GadListView
        .Position := 26
        .GadgetObject := "ListView"
        .gadgetObject_ := "ListView"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 13920
        End With  'ControlTools.Palette.GadListView.bitmap
      End With  'ControlTools.Palette.GadListView
      With .GadTabStrip
        .Position := 27
        .GadgetObject := "TabStrip"
        .gadgetObject_ := "TabStrip"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 14312
        End With  'ControlTools.Palette.GadTabStrip.bitmap
      End With  'ControlTools.Palette.GadTabStrip
      With .GadHyperControl
        .Position := 28
        .GadgetObject := "HyperControl"
        .gadgetObject_ := "HyperControl"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 10100
        End With  'ControlTools.Palette.GadHyperControl.bitmap
      End With  'ControlTools.Palette.GadHyperControl
      With .GadMenu
        .Position := 29
        .HintText := "Embed Menubar"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 9696
        End With  'ControlTools.Palette.GadMenu.bitmap
      End With  'ControlTools.Palette.GadMenu
      With .GadInstallButton
        .Position := 30
        .GadgetObject := "InstallButton"
        .gadgetObject_ := "InstallButton"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 10504
        End With  'ControlTools.Palette.GadInstallButton.bitmap
      End With  'ControlTools.Palette.GadInstallButton
      With .GadObjectBox
        .Position := 31
        .GadgetObject := "ObjectBox"
        .gadgetObject_ := "ObjectBox"
        With .bitmap
          .FileName := "tools.ero"
          .ResId := 12212
        End With  'ControlTools.Palette.GadObjectBox.bitmap
      End With  'ControlTools.Palette.GadObjectBox
      With .Empty
        .Position := 32
        With .bitmap
        End With  'ControlTools.Palette.Empty.bitmap
      End With  'ControlTools.Palette.Empty
    End With  'ControlTools.Palette
  End With  'ControlTools
' Reconstruction commands for object: ToolBitmap
'
  With ToolBitmap
    .Caption := "Configure Tool Gadget"
    .Move(1905, 5850, 7245, 4815)
    .DefaultButton := ToolBitmap.BtnFinish
    .BorderStyle := "Fixed Single"
    .Caller := Nothing
    With .LblBitmap
      .Caption := "Picture file:"
      .ZOrder := 5
      .Move(2850, 825, 1500, 225)
    End With  'ToolBitmap.LblBitmap
    With .TBBitmap
      .ZOrder := 4
      .Move(2850, 1125, 4050, 450)
    End With  'ToolBitmap.TBBitmap
    With .BtnFinish
      .Caption := "Done..."
      .ZOrder := 6
      .Move(6225, 4050, 825, 300)
    End With  'ToolBitmap.BtnFinish
    With .ImgGraphic
      .ZOrder := 7
      .Move(225, 225, 2475, 3150)
      .AutoInitCropRect := False
      .Picture := ToolBitmap.ImgGraphic.bitmap
      .ScrollBars := "Never"
      .CropXSize := 165
      .CropYSize := 210
      With .bitmap
        .LoadType := "MemoryBased"
      End With  'ToolBitmap.ImgGraphic.bitmap
    End With  'ToolBitmap.ImgGraphic
    With .LblInstruction
      .Caption := "Type a FileName for the bitmap or the ToolGadget, or press Browse..."
      .ZOrder := 8
      .Move(2850, 300, 4125, 450)
    End With  'ToolBitmap.LblInstruction
    With .Frame1
      .ZOrder := 9
      .Move(75, 3825, 6975, 75)
    End With  'ToolBitmap.Frame1
    With .BTNBrowse
      .Caption := "Browse..."
      .ZOrder := 3
      .Move(2850, 1725, 1050, 375)
    End With  'ToolBitmap.BTNBrowse
    With .SampleBox
      .Caption := "SampleBox"
      .ZOrder := 2
      .Move(4740, 2790, 345, 345)
      .Visible := True
      With .PreviewTool
        .Position := 1
        .HintText := "I am a frog"
        With .bitmap
          .LoadType := "FileBased"
          .FileName := "W:\test\objbox\objbox.bmp"
        End With  'ToolBitmap.SampleBox.PreviewTool.bitmap
      End With  'ToolBitmap.SampleBox.PreviewTool
    End With  'ToolBitmap.SampleBox
    With .BTNPreview
      .Caption := "Preview"
      .ZOrder := 1
      .Move(5625, 1725, 1200, 375)
    End With  'ToolBitmap.BTNPreview
  End With  'ToolBitmap
' Reconstruction commands for object: ToolPalette
'
  With ToolPalette
    .Caption := "Tools"
    .ZOrder := 1
    .Move(5025, 1125, 9315, 645)
    .NumColumns := -1
    .NumRows := 1
    .DropFeedbackGadget := Nothing
    .lastGad_ := Nothing
    With .AlignGadget
      .Enabled := False
      .Position := 1
      .HintText := "Align Left Edges"
      .alignType := 1
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 15096
      End With  'ToolPalette.AlignGadget.bitmap
    End With  'ToolPalette.AlignGadget
    With .AlignR
      .Position := 2
      .HintText := "Align Right Edges"
      .alignType := 2
      With .bitmap
        .ResId := 15500
      End With  'ToolPalette.AlignR.bitmap
    End With  'ToolPalette.AlignR
    With .AlignT
      .Position := 3
      .HintText := "Align Top Edges"
      .alignType := 4
      With .bitmap
        .ResId := 15904
      End With  'ToolPalette.AlignT.bitmap
    End With  'ToolPalette.AlignT
    With .AlignB
      .Position := 4
      .HintText := "Align Bottom Edges"
      .alignType := 8
      With .bitmap
        .ResId := 16308
      End With  'ToolPalette.AlignB.bitmap
    End With  'ToolPalette.AlignB
    With .AlignLR
      .Position := 5
      .HintText := "Align Left&Right Edges"
      .alignType := 19
      With .bitmap
        .ResId := 16712
      End With  'ToolPalette.AlignLR.bitmap
    End With  'ToolPalette.AlignLR
    With .AlignTB
      .Position := 6
      .HintText := "Align Top&Bottom Edges"
      .alignType := 28
      With .bitmap
        .ResId := 17116
      End With  'ToolPalette.AlignTB.bitmap
    End With  'ToolPalette.AlignTB
    With .SpaceH
      .Enabled := False
      .Position := 7
      .HintText := "Proportional Horizontal Spacing"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 17520
      End With  'ToolPalette.SpaceH.bitmap
    End With  'ToolPalette.SpaceH
    With .SpaceV
      .Enabled := False
      .Position := 8
      .HintText := "Proportional Vertical Spacing"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 17924
      End With  'ToolPalette.SpaceV.bitmap
    End With  'ToolPalette.SpaceV
    With .ToggleGrid
      .Position := 9
      .State := "Down"
      .ButtonType := "NonExclusive"
      .HintText := "Toggle Grid"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 18328
      End With  'ToolPalette.ToggleGrid.bitmap
    End With  'ToolPalette.ToggleGrid
    With .FormEditorUndo
      .Enabled := False
      .Position := 10
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 18732
      End With  'ToolPalette.FormEditorUndo.bitmap
    End With  'ToolPalette.FormEditorUndo
    With .FormEditorRedo
      .Enabled := False
      .Position := 11
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 19136
      End With  'ToolPalette.FormEditorRedo.bitmap
    End With  'ToolPalette.FormEditorRedo
    With .TouchMode
      .Position := 12
      .State := "Down"
      .ButtonType := "Exclusive"
      .HintText := "Selection mode: Region Touches"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 19540
      End With  'ToolPalette.TouchMode.bitmap
    End With  'ToolPalette.TouchMode
    With .ContainsMode
      .Position := 13
      .ButtonType := "Exclusive"
      .HintText := "Selection mode: Region Contains"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 19944
      End With  'ToolPalette.ContainsMode.bitmap
    End With  'ToolPalette.ContainsMode
    With .CopyGadget
      .Enabled := False
      .Position := 14
      .HintText := "Copy Controls"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 20348
      End With  'ToolPalette.CopyGadget.bitmap
    End With  'ToolPalette.CopyGadget
    With .Arrange
      .Enabled := False
      .Position := 15
      .HintText := "Arrange Controls"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 20752
      End With  'ToolPalette.Arrange.bitmap
    End With  'ToolPalette.Arrange
    With .Raise
      .Enabled := False
      .Position := 16
      .HintText := "Raise Controls"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 21156
      End With  'ToolPalette.Raise.bitmap
    End With  'ToolPalette.Raise
    With .Lower
      .Enabled := False
      .Position := 17
      .HintText := "Lower Controls"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 21560
      End With  'ToolPalette.Lower.bitmap
    End With  'ToolPalette.Lower
    With .ToggleTab
      .Position := 18
      .HintText := "Toggle Tab Order Display"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 21964
      End With  'ToolPalette.ToggleTab.bitmap
    End With  'ToolPalette.ToggleTab
    With .FontSet
      .Position := 19
      .HintText := "Set Font on Selected Controls"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 22368
      End With  'ToolPalette.FontSet.bitmap
    End With  'ToolPalette.FontSet
    With .FColorSet
      .Enabled := False
      .Position := 20
      .HintText := "Set ForeColor on Selected Controls"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 22772
      End With  'ToolPalette.FColorSet.bitmap
    End With  'ToolPalette.FColorSet
    With .BColorSet
      .Position := 21
      .HintText := "Set BackColor on Selected Controls"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 23176
      End With  'ToolPalette.BColorSet.bitmap
    End With  'ToolPalette.BColorSet
    With .ToggleObjectBoxEdit
      .Position := 22
      .State := "Down"
      .ButtonType := "NonExclusive"
      .HintText := "Toggle ObjectBox Editing On/Off"
      With .bitmap
        .FileName := "tools.ero"
        .ResId := 23580
      End With  'ToolPalette.ToggleObjectBoxEdit.bitmap
    End With  'ToolPalette.ToggleObjectBoxEdit
  End With  'ToolPalette
' Reconstruction commands for object: FedArray
'
  With FedArray
    .Caption := "Duplicate control in array pattern"
    .Move(4215, 3180, 5235, 3975)
    .Outlined := True
    .DefaultButton := FedArray.OK
    .CancelButton := FedArray.Cancel
    .runMode := 0
    With .Label1
      .Caption := "Cell layout"
      .ZOrder := 8
      .Move(150, 150, 1515, 375)
    End With  'FedArray.Label1
    With .Label2
      .Caption := "Cell size"
      .ZOrder := 9
      .Move(2550, 150, 1515, 375)
    End With  'FedArray.Label2
    With .Rows
      .ZOrder := 2
      .Move(1050, 1125, 1050, 360)
    End With  'FedArray.Rows
    With .Label3
      .Caption := "Columns"
      .ZOrder := 10
      .Move(150, 675, 840, 360)
    End With  'FedArray.Label3
    With .Columns
      .ZOrder := 1
      .Move(1050, 675, 1050, 375)
    End With  'FedArray.Columns
    With .Label4
      .Caption := "Rows"
      .ZOrder := 11
      .Move(150, 1125, 900, 375)
    End With  'FedArray.Label4
    With .WidthBox
      .ZOrder := 3
      .Move(3525, 675, 1110, 360)
    End With  'FedArray.WidthBox
    With .Label5
      .Caption := "Width"
      .ZOrder := 12
      .Move(2550, 675, 750, 360)
    End With  'FedArray.Label5
    With .HeightBox
      .ZOrder := 4
      .Move(3525, 1125, 1110, 360)
    End With  'FedArray.HeightBox
    With .Label6
      .Caption := "Height"
      .ZOrder := 13
      .Move(2550, 1125, 900, 360)
    End With  'FedArray.Label6
    With .ResizeBox
      .Caption := "Size controls to cell"
      .ZOrder := 5
      .Move(2550, 1650, 2400, 450)
    End With  'FedArray.ResizeBox
    With .Xoffset
      .ZOrder := 6
      .Move(1050, 1725, 1050, 360)
    End With  'FedArray.Xoffset
    With .Label7
      .Caption := "X offset"
      .ZOrder := 14
      .Move(150, 1725, 750, 360)
    End With  'FedArray.Label7
    With .Yoffset
      .ZOrder := 7
      .Move(1050, 2175, 1050, 360)
    End With  'FedArray.Yoffset
    With .Label8
      .Caption := "Y offset"
      .ZOrder := 15
      .Move(150, 2175, 900, 360)
    End With  'FedArray.Label8
    With .OK
      .Caption := "OK"
      .ZOrder := 16
      .Move(450, 3000, 1650, 450)
    End With  'FedArray.OK
    With .Cancel
      .Caption := "Cancel"
      .ZOrder := 17
      .Move(3000, 3000, 1650, 450)
    End With  'FedArray.Cancel
  End With  'FedArray
' Reconstruction commands for object: DataControl
'
  With DataControl
    .Move(7515, 5970, 2595, 765)
    .ButtonScale := 8
    With .DataMoveFirst
      .Caption := "<<"
      .ZOrder := 2
      .Move(0, 0, 309, 360)
    End With  'DataControl.DataMoveFirst
    With .DataMovePrev
      .Caption := "<"
      .ZOrder := 3
      .Move(309, 0, 309, 360)
    End With  'DataControl.DataMovePrev
    With .DataMoveNext
      .Caption := ">"
      .ZOrder := 4
      .Move(1855, 0, 309, 360)
    End With  'DataControl.DataMoveNext
    With .DataMoveLast
      .Caption := ">>"
      .ZOrder := 5
      .Move(2164, 0, 309, 360)
    End With  'DataControl.DataMoveLast
    With .DataLabel
      .BackColor := 12632256
      .DragMode := "No Drag"
      .ZOrder := 6
      .Move(618, 0, 1237, 360)
    End With  'DataControl.DataLabel
  End With  'DataControl
' Reconstruction commands for object: WindowLayoutItem
'
  With WindowLayoutItem
    .wnd := Nothing
    .top := 0
    .width := 0
    .height := 0
    .visible := False
    .left_ := 0
  End With  'WindowLayoutItem
' Reconstruction commands for object: HScrollBar
'
  With HScrollBar
    .Move(0, 0, 0, 0)
    .Orientation := "Horizontal"
    .Move(0, 0, 0, 0)
  End With  'HScrollBar
' Reconstruction commands for object: HelpFile
'
  With HelpFile
    .IsShowing := 0
  End With  'HelpFile
' Reconstruction commands for object: FontPicker
'
  With FontPicker
    .Caption := "Select Font"
    .Move(7530, 6855, 3135, 4110)
    .Outlined := True
    .FontRef := Nothing
    .Workaround := Font
    .AllowNewFont := True
    With .Cancel
      .Caption := "Cancel"
      .ForeColor := 4227327
      .ZOrder := 2
      .Move(2115, 3225, 750, 375)
    End With  'FontPicker.Cancel
    With .BtnNewFont
      .Caption := "New"
      .ZOrder := 1
      .Move(1050, 3225, 900, 375)
    End With  'FontPicker.BtnNewFont
    With .OK
      .Caption := "OK"
      .ForeColor := 4227327
      .ZOrder := 3
      .Move(150, 3225, 750, 375)
    End With  'FontPicker.OK
    With .NothingButton
      .Caption := "Set to ""Nothing"""
      .ZOrder := 4
      .Move(75, 2700, 2850, 300)
    End With  'FontPicker.NothingButton
    With .Sample
      .Caption := "AaBbYyZz"
      .ZOrder := 5
      .Move(75, 75, 2850, 825)
    End With  'FontPicker.Sample
    With .ObjList
      .Caption := "ObjList"
      .ZOrder := 6
      .Move(75, 975, 2850, 1650)
      .ShowEmbeds := True
      .RootObject := Font
    End With  'FontPicker.ObjList
  End With  'FontPicker
' Reconstruction commands for object: ScreenLayoutSet
'
  With ScreenLayoutSet
    .Default__Layout__ := Nothing
  End With  'ScreenLayoutSet
' Reconstruction commands for object: SuspendIgnoreExceptions
'
  With SuspendIgnoreExceptions
    .debugger := Nothing
    .IgnoreExceptionsModule := 0
  End With  'SuspendIgnoreExceptions
' Reconstruction commands for object: TempTextFile
'
  With TempTextFile
    .prefix := ""
  End With  'TempTextFile
End Code